StringCompact Function

public function StringCompact(string) result(new)

Converts multiple spaces and tabs to single spaces; deletes control characters; removes initial spaces. Arguments: string String to be treated Result: String compacted

Arguments

Type IntentOptional Attributes Name
character(len=*) :: string

Return Value character(len=LEN)


Variables

Type Visibility Attributes Name Initial
character(len=1), public :: ch
integer(kind=short), public :: i
integer(kind=short), public :: ich
integer(kind=short), public :: isp
integer(kind=short), public :: k
integer(kind=short), public :: length

Source Code

FUNCTION StringCompact &
  ( string )           &
RESULT (new)

IMPLICIT NONE

! Function arguments
! Scalar arguments with intent(in):
CHARACTER(LEN=*)   :: string

! Local scalars:
CHARACTER (LEN=LEN(string)) :: new
CHARACTER (LEN = 1)         :: ch
INTEGER (KIND = short)      :: isp
INTEGER (KIND = short)      :: ich
INTEGER (KIND = short)      :: i,k 
INTEGER (KIND = short)      :: length
!------------end of declaration------------------------------------------------

string = ADJUSTL (string)
length = LEN_TRIM (string)
new = ' '
isp = 0
k = 0

DO i = 1,length
  ch = string(i:i)
  ich = IACHAR (ch)
  
  SELECT CASE (ich)
  
    CASE(9,32)     ! space or tab character
      IF ( isp == 0 ) THEN
        k = k + 1
        new (k:k) = ' '
      END IF
      isp = 1
      
    CASE(33:)      ! not a space, quote, or control character
      k = k + 1
      new (k:k) = ch
      isp = 0
      
  END SELECT
  
END DO

new = ADJUSTL (new)

END FUNCTION StringCompact